(in-package :lilu-roswell)

(defun parse-options (argv &key (free-args-p t) (min-free-args nil) (max-free-args nil))
  (multiple-value-bind (options free-args)
      (handler-case
          (opts:get-opts argv)
        (opts:unknown-option (condition)
          (format t "fatal: ~A~%" condition)
          (opts:exit 1))
        (opts:missing-arg (condition)
          (format t "fatal: ~A~%" condition)
          (opts:exit 1))
        (opts:arg-parser-failed (condition)
          (format t "fatal: ~A~%" condition)
          (opts:exit 1))
        (opts:missing-required-option (condition)
          (format t "fatal: ~A~%" condition)
          (opts:exit 1)))
    (when (not (options-get-value options :help))
      (when (and free-args (not free-args-p))
        (format t "fatal: args (~{~s~^, ~}) unexpected ~%" free-args)
        (opts:exit 1))
      (let ((num (length free-args)))
        (when (and max-free-args (> num max-free-args))
          (format t "fatal: args (~{~s~^, ~}) are more than ~A~%" free-args max-free-args)
          (opts:exit 1))
        (when (and min-free-args (< num min-free-args))
          (format t "fatal: args (~{~s~^, ~}) are less than ~A~%" free-args min-free-args)
          (opts:exit 1))))
    (values options free-args)))

(defmacro when-option ((options opt) &body body)
  `(let ((it (getf ,options ,opt)))
     (when it
       ,@body)))

(defun options-get-value (options k)
  (when-option (options k)
    it))

(defun options-get-key (options k)
  (if (consp k)
    (when-option (options (car k))
      (list (cdr k) it))
    (when-option (options k)
      (list k it))))

(defun options-get-keys (options &rest keys)
  (loop for k in keys
        append (options-get-key options k)))

(defun options-make-enum-parser (plist)
  (lambda (v)
    (multiple-value-bind (found value)
        (loop for (x y) on plist
              when (equal x v)
                return (values t y))
      (unless found
        (error 'opts:arg-parser-failed))
      value)))

(defun options-check-for-help (options &key prefix suffix usage-of args)
  (when-option (options :help)
    (opts:describe
     :prefix prefix
     :suffix suffix
     :usage-of usage-of
     :args args)
    (opts:exit 0)))

;;
;;

(defun merge-options (option new-option)
  (loop for (prop val) on new-option
        do
           (setf (getf option prop) val))
  option)

(defparameter *default-help-option*
  '(:name :help
    :description "print this help text"
    :short #\h
    :long "help"))

(defparameter *default-debugger-option*
  `(:name :debugger
    :description (format nil "(DEBUGGER must be ~{~(~a~)~^/~})"
                         (lilu-app:list-all-debuggers :installed-p t))
    :required nil
    :default :quit
    :short #\d
    :long "debugger"
    :arg-parser (lilu-roswell:options-make-enum-parser
                 (mapcan #'(lambda (x) (list (string-downcase x) x))
                         (lilu-app:list-all-debuggers :installed-p t)))
    :meta-var "DEBUGGER"))

(defparameter *default-swank-port-option*
  '(:name :port
    :description "the swank port"
    :required nil
    :default 5004
    :short #\p
    :long "port"
    :arg-parser #'(lambda (v)
                    (parse-integer v :junk-allowed t))
    :meta-var "PORT"))

(defparameter *default-swank-host-option*
  '(:name :host
    :description "the swank host"
    :required nil
    :default "localhost"
    :long "host"
    :arg-parser #'identity
    :meta-var "HOST"))
